home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Tools 2
/
Amiga Tools 2.iso
/
tools
/
jade
/
lisp
/
shell.jl
< prev
next >
Wrap
Lisp/Scheme
|
1995-03-09
|
8KB
|
252 lines
;;;; shell.jl -- a process-in-a-buffer
;;; Copyright (C) 1994 John Harper <jsh@ukc.ac.uk>
;;; This file is part of Jade.
;;; Jade is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;; Jade is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;; You should have received a copy of the GNU General Public License
;;; along with Jade; see the file COPYING. If not, write to
;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(provide 'shell)
;;; This is a *very* quick package for running a subprocess in a buffer
;;; No completion whatsoever, my plan is to get the shell to do that for
;;; me, though I'm not sure how :-(
;;; By default this sets itself up to run a shell, but it can be used
;;; to provide the base for most types of line-based interaction with
;;; a subprocess. The gdb package is a good example -- it sets up the
;;; buffer-local shell- variables, calls shell-mode to install the
;;; subprocess then redefines the name of the mode and the keymaps.
;;; Its ctrl-c-keymap is built from a copy of shell-ctrl-c-keymap.
;; User options
(defvar shell-file-name (or (getenv "SHELL") "/bin/sh")
"The name of the shell program.")
(defvar shell-whole-line t
"When non-nil the whole line (minus the prompt) is sent to the shell
process when `RET' is typed, even if the cursor is not at the end of the
line.")
;; Program options
(defvar shell-program shell-file-name
"The program to run, by default the standard shell.")
(make-variable-buffer-local 'shell-program)
(defvar shell-program-args nil
"The arguments to give to the program when it's started.")
(make-variable-buffer-local 'shell-program-args)
(defvar shell-prompt-regexp "^[^\]#$%>\)]*[\]#$%>\)] *"
"A regexp matching the prompt of the shell.")
(make-variable-buffer-local 'shell-prompt-regexp)
(defvar shell-callback-function 'shell-default-callback
"Holds the function to call when the process changes state.")
(make-variable-buffer-local 'shell-callback-function)
(defvar shell-output-stream nil
"Stream to output to from subprocess. If nil the process' buffer is
written to. This is only consulted when the process is started.")
(make-variable-buffer-local 'shell-output-stream)
(defvar shell-process nil
"The process that the Shell mode created in the current buffer.")
(make-variable-buffer-local 'shell-process)
(defvar shell-keymap (make-keylist)
"Keymap for shell-mode.")
(bind-keys shell-keymap
"Ctrl-a" 'shell-bol
"Ctrl-d" 'shell-del-or-eof
"RET" 'shell-enter-line)
(defvar shell-ctrl-c-keymap (make-keylist)
"Keymap for ctrl-c in shell-mode.")
(bind-keys shell-ctrl-c-keymap
"Ctrl-c" 'shell-send-intr
"Ctrl-z" 'shell-send-susp
"Ctrl-d" 'shell-send-eof
"Ctrl-n" 'shell-next-prompt
"Ctrl-p" 'shell-prev-prompt
"Ctrl-\\" 'shell-send-quit)
;; Ensure that the termcap stuff is set up correctly
(setenv "TERM" "jade")
(setenv "TERMCAP" "jade:tc=unknown")
;;;###autoload
(defun shell-mode ()
"Shell Mode:\n
Major mode for running a subprocess in a buffer. Special commands are,\n
`Ctrl-a' Move to the start of this line (after the prompt)
`Ctrl-d' If at the end of the buffer send the ^D character,
otherwise delete the current character.
`RET' Send the current line to the process
`Ctrl-c Ctrl-c' Send the `intr' character to the process (`^C')
`Ctrl-c Ctrl-z' Send the `susp' character (`^Z')
`Ctrl-c Ctrl-d' Send the `eof' character (`^D')
`Ctrl-c Ctrl-\\' Send the `quit' character (`^\\')
`Ctrl-c Ctrl-n' Move to the next prompt
`Ctrl-c Ctrl-p' Move to the previous prompt"
(setq keymap-path (cons 'shell-keymap keymap-path)
ctrl-c-keymap shell-ctrl-c-keymap
mode-name "Shell"
major-mode 'shell-mode
major-mode-kill 'shell-mode-kill)
(shell-start-process)
(eval-hook 'shell-mode-hook))
(defun shell-mode-kill ()
(when shell-process
(unless (yes-or-no-p "Subprocess running; kill it?")
(error "Can't kill shell-mode without killing its subprocess"))
;; don't want the callback function to run or to output
(set-process-function shell-process nil)
(set-process-output-stream shell-process nil)
(kill-process shell-process nil)
(setq shell-process nil
mode-name nil
major-mode nil
major-mode-kill nil
keymap-path (delq 'shell-mode-keymap keymap-path)
ctrl-c-keymap nil)))
;; If a shell subprocess isn't running create one
(defun shell-start-process ()
(unless shell-process
(setq shell-process (make-process
(or shell-output-stream
(cons (current-buffer) t))
;; Create a function which switches to the
;; process' buffer then calls the callback
;; function (through its variable)
(list 'lambda '()
(list 'with-buffer (current-buffer)
(list 'funcall
'shell-callback-function)))
(file-name-directory (buffer-file-name))
shell-program
shell-program-args))
(set-process-connection-type shell-process 'pty)
(start-process shell-process)))
;; The default value of shell-callback-function
(defun shell-default-callback ()
(when shell-process
(insert (cond
((process-stopped-p shell-process)
"\nProcess suspended...")
((process-running-p shell-process)
"restarted\n")
(t
(setq shell-process nil)
"\nProcess terminated\n")))))
;; Commands
(defun shell-bol ()
"Go to the beginning of this shell line (but after the prompt)."
(interactive)
(if (regexp-match-line shell-prompt-regexp)
(goto-char (match-end))
(goto-char (line-start))))
(defun shell-del-or-eof (count)
"When at the very end of the buffer send the subprocess the EOF character,
otherwise delete the first COUNT characters under the cursor."
(interactive "p")
(if (equal (cursor-pos) (buffer-end))
(shell-send-eof)
(delete-char count)))
(defun shell-enter-line ()
"Send the current line to the shell process. If the current line is not the
last in the buffer the current command is copied to the end of the buffer."
(interactive)
(if (null shell-process)
(insert "\n")
(let
((start (if (regexp-match-line shell-prompt-regexp)
(match-end)
(line-start)))
cmdstr)
(if (= (pos-line start) (1- (buffer-length)))
;; last line in buffer
(progn
(when shell-whole-line
(goto-line-end))
(insert "\n")
(setq cmdstr (copy-area start (cursor-pos))))
;; copy the command at this line to the end of the buffer
(setq cmdstr (copy-area start (next-line 1 (line-start))))
(set-auto-mark)
(goto-buffer-end)
(insert cmdstr))
(write shell-process cmdstr))))
(defun shell-send-intr ()
(interactive)
(write shell-process ?\^C))
(defun shell-send-susp ()
(interactive)
(write shell-process ?\^Z))
(defun shell-send-eof ()
(interactive)
(write shell-process ?\^D))
(defun shell-send-quit ()
(interactive)
(write shell-process ?\^\ ))
(defun shell-next-prompt ()
(interactive)
(when (find-next-regexp shell-prompt-regexp (line-end))
(goto-char (match-end))))
(defun shell-prev-prompt ()
(interactive)
(when (find-prev-regexp shell-prompt-regexp (prev-char 1 (line-start)))
(goto-char (match-end))))
;;;###autoload
(defun shell ()
"Run a subshell in a buffer called `*shell*' using the major mode
`shell-mode'."
(interactive)
(let
((buffer (get-buffer "*shell*"))
(dir (file-name-directory (buffer-file-name))))
(if (or (not buffer) (with-buffer buffer shell-process))
(progn
(goto-buffer (make-buffer "*shell*"))
(set-buffer-file-name nil dir)
(set-buffer-special nil t)
(setq mildly-special-buffer t)
(shell-mode))
(goto-buffer buffer)
(set-buffer-file-name buffer dir)
(shell-start-process))))